home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / REFERENC / TPR / SOURCE.EXE / COPYFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-11  |  2KB  |  88 lines
  1. function CopyAFile ( Source, Dest : String ) : Integer;
  2.  
  3. { Purpose:
  4.   Copies the filenamed in 'Source' to the file named in 'Dest'.
  5.  
  6.   Returns:
  7.   0 = copy was okay
  8.   1 = not enough RAM memory to copy the file
  9.   2 = error occurred when writing to the 'Dest' file
  10.   3 = Could not open the source file
  11.   4 = Could not open the destination file
  12. }
  13. label
  14.   ExitProc;
  15.  
  16. type
  17.   TFileBuffer = Array [0..1023] of Byte;
  18.     { Copies the file in 1k chunks.  For a larger buffer, increase
  19.       the size of the byte array. }
  20. var
  21.   BytesIn  : Integer;   { Number of bytes read in }
  22.   BytesOut : Integer;   { Number of bytes written out }
  23.   F1 : File;            { F1=file to read, F2=file to write }
  24.   F2 : File;
  25.   FileBuffer : ^TFileBuffer;
  26.   Dialog : PDialog;
  27.   Bounds : TRect;
  28.  
  29. begin { CopyFile }
  30.  
  31.   New( FileBuffer );
  32.   if  FileBuffer = NIL  then
  33.     CopyAFile := 1 {Not enough RAM memory to do a copy}
  34.   else
  35.   begin
  36.  
  37.     { Open the source file }
  38.     Assign ( F1, Source );
  39.     {$I-}
  40.     Reset ( F1, 1 );
  41.     if  IoResult <> 0  then
  42.     begin
  43.       CopyAFile := 3; {Error on opening source file}
  44.       goto ExitProc;
  45.     end;
  46.  
  47.     { Open the destination file }
  48.     Assign ( F2, Dest );
  49.     Rewrite ( F2, 1 );
  50.     if  IoResult <> 0  then
  51.     begin
  52.       CopyAFile := 4; {Error on opening the destination file}
  53.       goto ExitProc;
  54.     end; { if }
  55.  
  56.     repeat
  57.       BlockRead ( F1, FileBuffer^, SizeOf(FileBuffer^), BytesIn );
  58.       if  BytesIn > 0  then
  59.       begin
  60.         { Since we read something, go ahead and write it to the destination }
  61.         BlockWrite ( F2, FileBuffer^, BytesIn, BytesOut );
  62.         if  BytesIn <> BytesOut  then
  63.         begin
  64.           CopyAFile := 2; {Error occurred while writing the output}
  65.           {$I-}
  66.           Close ( F2 );
  67.           Erase ( F2 );
  68.           Close ( F1 );
  69.           {$I+}
  70.       goto ExitProc;
  71.         end; { begin }
  72.       end; { if }
  73.     until  BytesIn = 0;
  74.  
  75.     CopyAFile := 0;
  76.     Close ( F1 );
  77.     Close ( F2 );
  78.  
  79.   end; { begin }
  80.  
  81. ExitProc:
  82.  
  83.   if  FileBuffer <> NIL  then
  84.     Dispose (FileBuffer);
  85.  
  86. end; { CopyAFile  }
  87.  
  88.